home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / RAMSES 2.2 / RAMSES 2.2 Extras / Alpha Editor Support / Modula-2.tcl < prev    next >
Text File  |  1996-06-21  |  36KB  |  1,399 lines
  1. ####################################################################################
  2. #                                                                                   #
  3. #    Modula.tcl:     macros    and    bindings for Modula    2 programmers                       #
  4. #                                                                                   #
  5. #    Usage:    See    "Modula    Help"                                                       #
  6. #                                                                                   #
  7. #    Programing:                                                                       #
  8. #      First    implementation was made    by Juerg Thoeny    <thoeny@ito.umnw.ethz.ch>       #
  9. #      Further improvementes    made by    Andreas    Fischlin <fischlin@ito.umnw.ethz.ch>   #
  10. #                                                                                   #
  11. #      Author    Date        Modification                                           #
  12. #      ------    ----        ------------                                           #
  13. #      af        21.05.95    Initialization for new Alpha >=    6.0b7 fixed               #
  14. #                            All    module templates fixed to behave usefully           #
  15. #      af        01.09.95    Initialization for new Alpha >=    6.01 fixed               #
  16. #                            All    module templates fixed to behave usefully           #
  17. #      af        10.06.96    Fixed a    few    Modula-2 tcl bugs (see SysEcol               #
  18. #                            bug    list)                                               #
  19. #      af        24.06.96    Fixed a    indentation    and    mark file bugs (see    SysEcol       #
  20. #                            bug    list)                                               #
  21. #                                                                                   #
  22. #    If you make    improvements to    this code, please send them    to us!                   #
  23. #    via    E-Mail:     RAMSES@ito.umnw.ethz.ch                                           #
  24. #                                                                                   #
  25. ####################################################################################
  26.  
  27. # Global Alpha stuff
  28.  
  29. #set modMenu         "•400"
  30. set m2Menu         "M2"
  31. set M2CommentPreString "(*"
  32. set M2CommentSufString "*)"
  33.  
  34. set modeMenus(M2)                 m2Menu
  35. lappend allModeMenus            m2Menu
  36. lappend modeSuffixes            {*.mod} { set winMode M2 }
  37. lappend modeSuffixes            {*.MOD} { set winMode M2 }
  38. lappend modeSuffixes            {*.def} { set winMode M2 }
  39. lappend modeSuffixes            {*.DEF} { set winMode M2 }
  40. set M2modeVars(wordBreakPreface)    {[^a-zA-Z0-9]}
  41. set M2modeVars(wordBreak)            {[a-zA-Z0-9]+}
  42. set M2modeVars(elecRBrace)            {0}
  43. set M2modeVars(electricSemi)        {0}
  44. set M2modeVars(elecLBrace)            {0}
  45. set M2modeVars(wordWrap)            {1}
  46. set M2modeVars(prefixString)        {(*}
  47. set M2modeVars(suffixString)        {*)}
  48. set M2modeVars(funcExpr)            {^[ |\t]*PROCEDURE[ ]*([a-zA-Z0-9]*)}
  49. set M2modeVars(optionIsMeta)        {1}
  50. set M2modeVars(tagFile)            "$HOME:modTAGS"
  51. set M2modeVars(funcTitle)            {PROC}
  52. lappend modes M2
  53. #buildModeFlagMenu
  54.  
  55. # Modula 2 stuff
  56.  
  57. # template bodys. Note, % means next line. To customize the template expansion, find the string
  58. # "M2 TEMPLATES". Procedure and module templates are "directly coded". Be careful with customizing.
  59.  
  60. set templateBodys(CASE) "  OF%| (*. .*):%  (*. .*);%| (*. .*):%  (*. .*);%ELSE%  (*. .*);%END(*CASE*);"
  61. set templateBodys(FOR) "  :=  TO  DO%END(*FOR*);"
  62. set templateBodys(WHILE) " () DO%END(*WHILE*);"
  63. set templateBodys(WITH) "  DO%END(*WITH*);"
  64. set templateBodys(REPEAT) "%UNTIL ();"
  65. set templateBodys(IF) "  THEN%ELSE%END(*IF*);"
  66. set templateBodys(FROM) "  IMPORT ;"
  67.  
  68.  
  69. # This procedure will be called on the activate event.
  70. proc handleM2ErrToken {} {
  71.     global M2TokenFile
  72.     if {[file exists "$M2TokenFile"]} {
  73.         source  "$M2TokenFile"
  74.         removeFile "$M2TokenFile"
  75.     }
  76.     
  77. }
  78.  
  79. # configuration stuff
  80.  
  81. set defaultFont Programmer
  82.  
  83. set M2Loaded {0}
  84.  
  85.  
  86. proc defineIndentation {} { 
  87.     global M2RightShift
  88.     global M2LeftShift
  89.     set maxTabWidth 31
  90.     if {[info exists M2RightShift]} then {
  91.         set defltRIndent $M2RightShift
  92.     } else {        
  93.         set defltRIndent "  "
  94.     }
  95.     set Defltcount [string length $defltRIndent]
  96.     set prompt "By how many spaces shall «Tab»/«Shift right» move text?"
  97.     if {[catch {getline $prompt $Defltcount } count]} then {} 
  98.     if {$count == ""} then {return}
  99.     set intCount ""
  100.     catch { set intCount [expr int($count)]}
  101.     if {$intCount == $count} then {
  102.         if {[expr (0 <= $intCount) & ($intCount <= $maxTabWidth)]} then {
  103.             # Now create the variables to make them accessible immediately
  104.             set M2RightShift ""
  105.             for {set i 0} {$i < $count} {incr i} {
  106.                 set M2RightShift "$M2RightShift "
  107.             }
  108.             set M2LeftShift ""
  109.             for {set i 0} {$i < $count} {incr i; incr i} {
  110.                 set M2LeftShift "$M2LeftShift "
  111.             }
  112.             if {($M2LeftShift == "") & ($M2RightShift != "")} then {
  113.                 set M2LeftShift " "
  114.             }
  115.             addDef M2RightShift $M2RightShift
  116.             addDef M2LeftShift $M2LeftShift
  117.             set msg "«Tab»/«Shift right» shifts selection by [string length $M2RightShift],"
  118.             set msg "$msg «Shift left» shifts it by [string length $M2LeftShift] spaces."
  119.             alertnote $msg
  120.         } else {
  121.             alertnote "Please enter a number in range 0..$maxTabWidth"
  122.             catch { unset M2RightShift}
  123.             catch { unset M2LeftShift}
  124.         }
  125.     } else {
  126.         set msg "'$count' is not an integer!"
  127.         set msg "$msg Please enter a number in range 0..$maxTabWidth"
  128.         alertnote $msg
  129.         catch { unset M2RightShift}
  130.         catch { unset M2LeftShift}
  131.     }         
  132. }
  133.  
  134.  
  135.  
  136. proc defineWrapRightMargin {} { 
  137.     global M2WrapRightMargin
  138.     set minWTRM 2
  139.     set maxWTRM 256
  140.     if {[info exists M2WrapRightMargin]} then {
  141.         set defltWTRM $M2WrapRightMargin
  142.     } else {        
  143.         set defltWTRM 65
  144.     }
  145.     set prompt "At which right margin (column) shall text be wrapped?"
  146.     if {[catch {getline $prompt $defltWTRM } userWTRM]} then {} 
  147.     if {$userWTRM == ""} then {return}
  148.     set intWTRM ""
  149.     catch { set intWTRM [expr int($userWTRM)]}
  150.     if {$intWTRM == $userWTRM} then {
  151.         if {[expr ($minWTRM <= $intWTRM) & ($intWTRM <= $maxWTRM)]} then {
  152.             # it's now ok
  153.             set M2WrapRightMargin "$userWTRM"
  154.             addDef M2WrapRightMargin $M2WrapRightMargin
  155.         } else {
  156.             alertnote "Please enter a number in range $minWTRM..$maxWTRM"
  157.             catch { unset M2WrapRightMargin}
  158.         }
  159.     } else {
  160.         set msg "'$M2WrapRightMargin' is not an integer!"
  161.         set msg "$msg Please enter a number in range $minWTRM..$maxWTRM"
  162.         alertnote $msg
  163.         catch { unset M2WrapRightMargin}
  164.     }         
  165. }
  166.  
  167.  
  168.  
  169. proc configureLaunching {} {
  170.     global M2Home
  171.     global M2TokenFile
  172.     global M2System
  173.     global M2ErrFile
  174.     global M2errDOKFile
  175.     global USER_STARTUP
  176.     
  177.     set msg "Please configure the Modula-2 environment for the launching of a shell "
  178.     set msg "$msg and the compiler support."
  179.     alertnote $msg
  180.     
  181.     if {[catch {getfile "Open a M2 shell (MacMETH or RAMSES)"} path]} then {
  182.         # immediately quit routine
  183.         return 1
  184.     }
  185.     set fileDir [file dirname $path]
  186.     addDef M2System $path
  187.     addDef M2Home $fileDir
  188.     addDef M2TokenFile "$fileDir:token.ALPHA"
  189.     addDef M2ErrFile "$fileDir:err.ALPHA"
  190.     # Now create the variables to make them accessible immediately
  191.     set M2System $path
  192.     set M2Home $fileDir
  193.     set M2TokenFile "$fileDir:token.ALPHA"
  194.     set M2ErrFile "$fileDir:err.ALPHA"
  195.  
  196.     if {[catch {getfile "Locate 'ErrList.DOK' (look in ƒ M2Tools)"} errpath]} {
  197.         # immediately quit routine
  198.         return 1
  199.     }
  200.     addDef M2errDOKFile $errpath
  201.     # Now create the variable to make it accessible immediately
  202.     set M2errDOKFile $errpath
  203. }
  204.  
  205.  
  206.  
  207. proc configure {} {
  208.     global M2Author
  209.     global M2RightShift
  210.     global M2WrapRightMargin
  211.     
  212.     set prompt "Your first and last name please:"
  213.     if {[info exists M2Author]} then {
  214.         set defltUser $M2Author
  215.     } else {        
  216.         set defltUser "First Last"
  217.     }
  218.     if {[catch {getline $prompt $defltUser } author]} then {} 
  219.     if {$author == ""} then {return}
  220.     addDef M2Author $author
  221.     # Now create the variable to make it accessible immediately
  222.     set M2Author $author    
  223.  
  224.     # Now define indentation
  225.     defineIndentation
  226.     if {![info exists M2RightShift]} then {return}
  227.         
  228.     # Now define right text wrap margin
  229.     defineWrapRightMargin
  230.     if {![info exists M2WrapRightMargin]} then {return}
  231. }
  232.  
  233.  
  234. # Make sure configuration is ok
  235. if {[catch {set M2ConfTest "$M2System"}]} then {
  236.     configureLaunching
  237. } elseif {![file exists "$M2System"]} then {
  238.     set shellName [file tail "$M2System"]
  239.     set quest "Could not find the Modula-2 shell “$shellName“. "
  240.     append quest "Do you wish to reconfigure the Modula-2 environment?"
  241.     if {[askyesno $quest] == "yes"} then {
  242.         configureLaunching
  243.     }
  244. }
  245.  
  246.  
  247. # Make sure M2Author is defined
  248. while {![info exists M2Author]} {
  249.     configure
  250. }
  251.  
  252. # Make sure M2RightShift is defined
  253. while {![info exists M2RightShift]} {
  254.     defineIndentation
  255. }
  256.  
  257. # Make sure M2WrapRightMargin is defined
  258. while {![info exists M2WrapRightMargin]} {
  259.     defineWrapRightMargin
  260. }
  261.  
  262.  
  263. # Basic M2 binding to open work object
  264. bind '0' <z> openM2WorkFiles
  265.  
  266. set returnCompleteWords "FOR FROM"
  267. set returnWords "$returnCompleteWords BEGIN CONST ELSE WHILE IF PROCEDURE WITH" 
  268. set returnWords "$returnWords MODULE REPEAT TYPE VAR"
  269.  
  270. set spaceWords  "CASE WHILE FOR IF REPEAT FROM PROCEDURE IMPLEMENTATION DEFINITION LOOP MODULE WITH"
  271.  
  272. set expandWords "ARRAY BOOLEAN BITSET CHAR CARDINAL DO END LONGCARD LONGINT LONGREAL"
  273. set expandWords " $expandWords IMPORT INTEGER OF POINTER REAL RECORD RETURN TO"
  274. set expandWords [lsort "$returnWords $spaceWords $expandWords"]
  275.  
  276. set m2ErrRing ""
  277.  
  278. # M2 KEY BINDINGS
  279. bind '1'  <z> launchShell
  280. bind '2'  <z> launchShellAndSimulate
  281. bind '0'  <z> openWorkFiles
  282. bind 0x24 <s> carriageReturn    "M2"      
  283. bind 0x24     modulaReturn      "M2"
  284. bind 0x31     modulaSpace       "M2" 
  285. bind 0x33 <z> killWholeLine     "M2"
  286. bind 0x31 <e> expandSpace       "M2"
  287. bind 0x25 <e> markLine          "M2"
  288. bind 0x2e <z> markLine          "M2"
  289. bind 0x7c <z> forwardWord       "M2"
  290. bind 0x7b <z> backwardWord      "M2"
  291. bind 0x30     modulaTab         "M2"
  292. bind 0x73 <z> beginningOfBuffer "M2"
  293. bind 0x77 <z> endOfBuffer       "M2"
  294. bind 'g'  <z> nextPlaceholder   "M2"
  295. bind 'g' <sz> prevPlaceholder   "M2"
  296. bind '\]' <o> m2ShiftRight      "M2"
  297. bind 'r'  <z> m2ShiftRight      "M2"
  298. bind '\[' <o> m2ShiftLeft       "M2"
  299. bind 'l'  <z> m2ShiftLeft       "M2"
  300. bind 'k' <z>  commentSelection  "M2"
  301. bind 'k' <sz> uncommentSelection "M2"
  302. bind 'a' <sz> wrapText          "M2"
  303. bind 'a' <z>  wrapComment       "M2"
  304. bind  0x33 <o> killLine         "M2"
  305.  
  306.  
  307. # 'M2' programming mode 
  308.  
  309. proc setM2Mode {} {
  310.     changeMode "M2"
  311. }
  312.  
  313. proc killWholeLine {} {
  314.     goto [lineStart [getPos]]
  315.     killLine
  316. }
  317.  
  318. #================================================================================
  319. proc actionOnReturn {} {
  320.     set pos [getPos]
  321.     deleteText $pos [selEnd]
  322.     goto $pos
  323.     endOfLine
  324.     carriageReturn    
  325. }
  326.  
  327. #================================================================================
  328. proc modulaTab {} {
  329.     global M2RightShift
  330.     insertText $M2RightShift
  331. }
  332.  
  333. proc wrapComment {} {
  334.     global leftFillColumn
  335.     global M2RightShift
  336.     global M2WrapRightMargin
  337.     global fillColumn
  338.     set increment [string length $M2RightShift]
  339.     set pos [getPos]
  340.     set end [selEnd]
  341.     if {$pos == $end} {
  342.         balance
  343.         set pos [getPos]
  344.         set end [selEnd]
  345.         if {$pos == $end} {
  346.             beep
  347.             message "Please make a selection"
  348.             return
  349.         }
  350.     }
  351.     set firstPos [lindex [search -s -r 1 -f 1 -n -- "\\(\\*" $pos] 0]
  352.     if {$firstPos == ""} {
  353.         beep
  354.         message "No comment in selection"
  355.         return
  356.     }
  357.     if {$firstPos > $end} {
  358.         beep
  359.         message "Empty selection?"
  360.         return
  361.     }
  362.     set lastPos [matchIt "\(" [expr $firstPos +$increment]]
  363.     if {$lastPos > $end} {
  364.         beep
  365.         message "Comment must be completely inside selection"
  366.         return
  367.     }
  368.     goto [expr $firstPos + $increment]
  369.     carriageReturn
  370.     set lastPos [matchIt "\(" [expr $firstPos +$increment]]
  371.     select [getPos] [expr $lastPos +1]
  372.     set tmpLeftFillColumn $leftFillColumn
  373.     set leftFillColumn [expr [lindex [posToRowCol $firstPos] 1] + $increment]
  374.     set tmpfillColumn $fillColumn
  375.     set fillColumn $M2WrapRightMargin
  376.     fillRegion
  377.     set leftFillColumn $tmpLeftFillColumn
  378.     set fillColumn $tmpfillColumn
  379.     goto [expr [matchIt "\(" [expr $firstPos +$increment]] -1]
  380.     carriageReturn
  381.     unIndent
  382.     set topTxtLeftMargRow [lindex [posToRowCol $firstPos] 0]
  383.     set topTxtLeftMargRow [expr $topTxtLeftMargRow +1]
  384.     set topTxtLeftMarg [rowColToPos $topTxtLeftMargRow 0]
  385.     set textBeg [expr [lindex [posToRowCol $firstPos] 1] + $increment]
  386.     set count [expr $textBeg]
  387.     goto $topTxtLeftMarg
  388.     for {set i 0} {$i < $count} {incr i} {
  389.         deleteChar
  390.     }
  391.     goto $firstPos
  392. }
  393.  
  394.  
  395. proc wrapText {} {
  396.     global leftFillColumn
  397.     global fillColumn
  398.     global M2WrapRightMargin
  399.     global fillColumn
  400.     set pos [getPos]
  401.     set end [selEnd]
  402.     if {$pos == $end} {
  403.         beep
  404.         message "Please make a selection"
  405.         return
  406.     }
  407.     set firstPos [search -s -r 1 -f 1 -n -- "\[\^ \\t\\r\]" $pos]
  408.     if {$firstPos > $end} {
  409.         beep
  410.         message "Empty selection?"
  411.         return
  412.     }
  413.     set tmpLeftFillColumn $leftFillColumn
  414.     set tmpfillColumn $fillColumn
  415.     set leftFillColumn [lindex [posToRowCol $firstPos] 1]
  416.     set fillColumn $M2WrapRightMargin
  417.     fillRegion
  418.     set leftFillColumn $tmpLeftFillColumn
  419.     set fillColumn $tmpfillColumn
  420.     
  421.     set topTxtLeftMargRow [lindex [posToRowCol $firstPos] 0]
  422.     set topTxtLeftMarg [rowColToPos $topTxtLeftMargRow 0]
  423.     set textBeg [lindex [posToRowCol $firstPos] 1]
  424.     set count [expr $textBeg]
  425.     goto $topTxtLeftMarg
  426.     for {set i 0} {$i < $count} {incr i} {
  427.         deleteChar
  428.     }
  429.     goto $pos
  430. }
  431.  
  432.  
  433. #================================================================================
  434. proc nextPlaceholder {} {
  435.     searchPlaceholder 1
  436. }
  437. proc prevPlaceholder {} {
  438.     searchPlaceholder 0
  439. }
  440.  
  441. proc commentSelection {} {
  442.     set pos [getPos]
  443.     set end [selEnd]
  444.     if {$pos == $end} {
  445.         beep
  446.         message "Please make a selection"
  447.         return
  448.     }
  449.     replaceText $pos $end "\(\*\. [getText $pos $end] \.\*\)"
  450.     select $pos [expr $end + 8]
  451. }
  452.  
  453. proc uncommentSelection {} {
  454.     set pos [getPos]
  455.     set end [selEnd]
  456.     if {$pos == $end} {
  457.         beep
  458.         message "Please make a selection"
  459.         return
  460.     }
  461.     if {[expr $end - $pos] < 8} {
  462.         beep
  463.         message "Selection to small"
  464.         return
  465.     }
  466.     if {[getText $pos [expr $pos + 4]] != "(*. "} {
  467.         beep
  468.         message "Wrong left comment-start in selection"
  469.         return
  470.     }
  471.     if {[getText [expr $end - 4] $end] != " .*)"} {
  472.         beep
  473.         message "Wrong right comment-start in selection"
  474.         return
  475.     }
  476.     replaceText [expr $end - 4] $end ""
  477.     replaceText $pos [expr $pos + 4] ""
  478.     select $pos [expr $end - 8]
  479. }
  480.  
  481. #================================================================================
  482. proc m2ShiftLeft {} {
  483.     global M2LeftShift
  484.     set start [lineStart [getPos]]
  485.     set end   [nextLineStart [expr [selEnd] -1]]
  486.     set increment [string length $M2LeftShift]
  487.     for {set i $start} {$i < $end} {set i [nextLineStart $i]} {
  488.         if {[getText $i [expr $i + $increment]] != $M2LeftShift} {
  489.             beep
  490.             return
  491.         } 
  492.     }
  493.     select $start $start
  494.     for {set i $start} {$i < $end} {set i [nextLineStart $i]} {
  495.         incr end -$increment
  496.         goto $i
  497.         replaceText $i [expr $i + $increment] ""
  498.     }
  499.     goto $start
  500.     select $start $end
  501. }
  502.  
  503.  
  504. #================================================================================
  505. proc m2ShiftRight {} {
  506.     global M2RightShift
  507.     set start [lineStart [getPos]]
  508.     set end   [nextLineStart [expr [selEnd] -1]]
  509.     select $start $start
  510.     set increment [string length $M2RightShift]
  511.     for {set i $start} {$i < $end} {set i [nextLineStart $i]} {
  512.         incr end $increment
  513.         goto $i
  514.         insertText $M2RightShift
  515.     }
  516.     goto $start
  517.     select $start $end
  518. }
  519.  
  520. #================================================================================
  521. proc searchPlaceholder {dir} {
  522.     set pos [getPos]
  523.     saveVars
  524.     set depth 1
  525.     if ($dir==1) {
  526.         set push "(*."
  527.         set pop  ".*)"
  528.         if {[getSelect] != ""} {
  529.             incr pos
  530.         }
  531.         set add 3;
  532.         set position [search -s -r 1 -f $dir -n -- "\\(\\*\\." $pos]
  533.     } else {
  534.         set push  ".*)"
  535.         set pop   "(*."
  536.         set pos [expr [selEnd]-4]
  537.         set add -3;
  538.         set position [search -s -r 1 -f $dir -n -- "\\.\\*\\)" $pos]
  539.     }
  540.     if {$position != ""} {
  541.         set pos [expr "[lindex $position 0]+$add"]
  542.         set str "(\\(\\*\\.)|(\\.\\*\\))"
  543.         while {1} {
  544.             set limits [search -s -r 1 -f $dir -n -- "$str" $pos]
  545.             if {$limits == ""}  {
  546.                 message "Not matched placeholder"
  547.                 beep
  548.                 restoreVars
  549.                 return
  550.             }
  551.             set pos [lindex $limits 0]
  552.             set c [getText $pos [expr "$pos+3"]]
  553.             if {$c == $push} {
  554.                 incr depth
  555.             } 
  556.             if {$c == $pop} {
  557.                 if {[set depth [expr $depth-1]] == 0} {
  558.                     if ($dir==1) {
  559.                         select [lindex $position 0] [expr "$pos+3"]
  560.                     } else {
  561.                         select $pos [lindex $position 1]
  562.                     }
  563.                     restoreVars
  564.                     return
  565.                 }
  566.             }
  567.             set pos [expr $pos+$add]
  568.             if {$pos > [maxPos]} {
  569.                 alertnote "makro error, please contact jth"
  570.             }
  571.         }
  572.     } else {
  573.         message "no more placeholders"
  574.         beep
  575.     }
  576.     restoreVars
  577. }
  578.  
  579. #===========================================================================
  580. # Modula routines.
  581. #===========================================================================
  582. menu -n $m2Menu {
  583.     "openWorkFiles"
  584.     "findNextError"
  585.     "launchShell"
  586.     "launchShellAndSimulate"
  587.     "(-"
  588.     "DefToMod"
  589.     "commentSelection"
  590.     "uncommentSelection"
  591.     "m2ShiftRight"
  592.     "m2ShiftLeft"
  593.     "wrapComment"
  594.     "wrapText"
  595.     "(-"
  596.     {menu -n templates -m {
  597.             "DEFINITION"
  598.             "FOR"
  599.             "IF"
  600.             "IMPLEMENTATION"
  601.             "PROCEDURE"
  602.             "MODULE"
  603.             "WHILE"
  604.             "WITH"
  605.         }
  606.     }
  607.     "configureLaunching"
  608.     "configure"
  609. }
  610.  
  611. #================================================================================
  612. proc fileExt {} {
  613.     set fileName [lindex [winNames -f] 0]
  614.     if {[string last "." $fileName] == -1} {
  615.         return " "
  616.     }
  617.     set fileName [split $fileName .]
  618.     return [lindex $fileName [expr "[llength $fileName]-1"]]
  619. }
  620.  
  621.     
  622. #================================================================================
  623. proc removeM2ErrMarks {fileName} {
  624.     global m2ErrRing
  625.     while 1 {
  626.         set ind [lsearch $m2ErrRing "*$fileName*"]
  627.         if {$ind == "-1"} {
  628.             return
  629.         }
  630.         set m2ErrRing [lreplace $m2ErrRing $ind $ind]
  631.     }
  632. }
  633.  
  634. #================================================================================
  635. proc removeAllM2ErrMarks {} {
  636.     global m2ErrRing
  637.     while {[llength $m2ErrRing] != 0} {
  638.         removeTMark [lindex [lindex $m2ErrRing 0] 1]
  639.         set m2ErrRing [lreplace $m2ErrRing 0 0]
  640.     }
  641. }
  642.  
  643. #================================================================================
  644. proc actM2ErrMsg {} {
  645.     global m2ErrRing
  646.     global errList
  647.     beep
  648.     if {[llength $m2ErrRing] == "0"} {
  649.         message "No Modula errors"
  650.         beep
  651.         return
  652.     }
  653.     set num [lindex [lindex $m2ErrRing 0] 2]
  654.     regexp "$num\[ \]+(\[^\n\]*)" $errList dummyStr errMsg
  655.     set errMsg [string range $errMsg 0 40]
  656.     message $errMsg
  657. }
  658.  
  659.  
  660. #================================================================================
  661. proc findNextError {} {
  662.     global m2ErrRing
  663.     global errList
  664.     set fileName [lindex [winNames -f] 0]
  665.     if {[llength $m2ErrRing] == "0"} {
  666.         beep
  667.         message "No more errors"
  668.         return
  669.     }
  670.     set first [lindex $m2ErrRing 0]
  671.     set m2ErrRing [lreplace $m2ErrRing 0 0]
  672.     set m2ErrRing [lappend m2ErrRing $first]
  673.     gotoTMark [lindex [lindex $m2ErrRing 0] 1]
  674.     if {$fileName != [lindex [winNames -f] 0]} {
  675.         centerRedraw
  676.     }
  677.     selectCurWord
  678.     actM2ErrMsg
  679. }
  680.  
  681.  
  682.  
  683. #================================================================================
  684. set loadM2ErrorMsg ""
  685.  
  686. proc openM2WorkFiles {} {
  687.     saveVars
  688.     global m2ErrRing
  689.     global errList
  690.     global M2ErrFile
  691.     global M2errDOKFile
  692.     global M2Home
  693.     global loadM2ErrorMsg
  694.     removeAllM2ErrMarks
  695.     set m2ErrRing ""
  696.     bind 'j' <z> findNextError "M2"
  697.     bind 'e' <z> findNextError "M2"
  698.     set loadM2ErrorMsg "opening or reading $M2errDOKFile"
  699.     set msgFile [open "$M2errDOKFile"]
  700.     set errList [read $msgFile]
  701.     close $msgFile
  702.     set loadM2ErrorMsg "opening or reading $M2ErrFile"
  703.     set errFile [open "$M2ErrFile"]
  704.     if  {[gets $errFile lineStr] < 1} {
  705.         beep
  706.         message "No Errors found"
  707.         close $errFile
  708.         return
  709.     }
  710.     set numErrs 0
  711.     set i 1
  712.     while {$lineStr == "NEW"} {
  713.         if  {[gets $errFile lineStr] < 1} {
  714.           break
  715.         }
  716.         set loadM2ErrorMsg "opening $lineStr"
  717.         set ind [lsearch [winNames -f] $lineStr]
  718.         if {$ind == -1} {
  719.             if {[file exists $lineStr]} {
  720.                 edit "$lineStr"
  721.             } else {
  722.                 edit "$M2Home$lineStr"
  723.             }
  724.         } else {
  725.             bringToFront [lindex [winNames] $ind]
  726.         }
  727.         set loadM2ErrorMsg "opening or reading $M2ErrFile"
  728.         if  {[gets $errFile lineStr] < 1} {
  729.           break
  730.         }
  731.         set fileName [lindex [winNames -f] 0]
  732.         while {($lineStr != "NEW") && ($lineStr != "END")} {
  733.             scan $lineStr "%d %d" pos errNum
  734.             if  {[gets $errFile lineStr] < 1} {
  735.                   break
  736.             }
  737.             goto $pos
  738.             createTMark "errMark$i" $pos
  739.             set m2ErrRing [lappend m2ErrRing [list $fileName errMark$i $errNum]]
  740.             set i [expr $i+1]
  741.             set numErrs [expr $numErrs+1]
  742.         }
  743.     }
  744.     if {$numErrs < 1} {
  745.         beep
  746.         message "No Errors found"
  747.         close $errFile
  748.         return
  749.     }
  750.     close $errFile
  751.     gotoTMark errMark1
  752.     restoreVars
  753.     set pos [getPos]
  754.     centerRedraw
  755.     selectCurWord
  756.     actM2ErrMsg
  757. }
  758. proc openWorkFiles {} {
  759.     global loadM2ErrorMsg
  760.     if {[catch openM2WorkFiles]} {
  761.         beep
  762.         alertnote "Error: $loadM2ErrorMsg"
  763.     }
  764. }
  765.  
  766. #================================================================================
  767. proc callM2 {} {
  768.     global M2System
  769.     launch -f "$M2System"
  770. }
  771. proc launchShell {} {
  772.     if {[catch callM2]} {
  773.         beep
  774.         alertnote "Call of M2 went wrong.\rCheck configuration."
  775.     }
  776. }
  777. proc launchShellAndSimulate {} {
  778.     if {[catch callM2]} {
  779.         beep
  780.         alertnote "Call of M2 went wrong.\rCheck configuration."
  781.     }
  782.     dosc -n " RAMSES Shell 2.2b6" -k 'DMEv' -e 'COMP' -s "gaga" -r
  783. }
  784.  
  785.  
  786. #================================================================================
  787. proc markLine {} {
  788.     set pos [getPos]
  789.     set start [lineStart $pos]
  790.     set end [nextLineStart $pos]
  791.     select $start $end
  792. }
  793.  
  794. #================================================================================
  795. proc trim {text} {
  796.     return [string trim $text]
  797. }
  798.  
  799. #================================================================================
  800. proc getCurLine {} {
  801.     set pos [getPos]
  802.     set start [lineStart $pos]
  803.     set end [nextLineStart $pos]
  804.     set text [getText $start $end]
  805.     regexp "(\[^\r\]*)\r?" $text dummyText text
  806.     return $text
  807. }
  808.  
  809. #================================================================================
  810. proc getCurWord {} {
  811.     set pos [getPos]
  812.     backwardWord
  813.     set bPos [getPos]
  814.     if {$bPos == 1} {
  815.         set text " "
  816.         regexp "\[A-Za-z\]" [getText 0 1] text
  817.         if {$text != " "} {
  818.             set bPos 0
  819.         }
  820.     }
  821.     
  822.     forwardWord
  823.     set fPos [getPos]
  824.     goto $pos
  825.     return [getText $bPos $fPos]
  826. }
  827.  
  828. #================================================================================
  829. proc selectCurWord {} {
  830.     set pos [getPos]
  831.     set char [lookAt [expr "$pos-1"]]
  832.     if {[regexp "\[A-Za-z\]" $char] == 0} {
  833.         set bPos [expr "$pos+1"]
  834.     } else {
  835.         backwardWord
  836.         set bPos [getPos]
  837.         if {$bPos == 1} {
  838.             set text " "
  839.             regexp "\[A-Za-z\]" [getText 0 1] text
  840.             if {$text != " "} {
  841.                 set bPos 0
  842.             }
  843.         }
  844.         
  845.         forwardWord
  846.     }
  847.     select $bPos [getPos]
  848. }
  849.  
  850. #================================================================================
  851. proc firstWord {text} {
  852.     regexp "\[ |\t\]*(\[A-Za-z0-9_\]*)(.*)" $text text firstWd rest
  853.     return $firstWd
  854. }
  855. proc restWord {text} {
  856.     regexp "\[ |\t\]*(\[A-Za-z0-9_\]*)(.*)" $text text firstWd rest
  857.     return $rest
  858. }
  859.  
  860. #================================================================================
  861. proc initials {} {
  862.   global M2Author
  863.   return "[string index [lindex "$M2Author" 0]  0][string index [lindex "$M2Author" 1]  0]"
  864. }
  865.  
  866. #================================================================================
  867. proc unIndent {} {
  868.     global M2RightShift
  869.     set count [string length $M2RightShift]
  870.     for {set i 0} {$i < $count} {incr i} {
  871.         backSpace
  872.     }
  873. }
  874.  
  875. # M2 TEMPLATES
  876. #================================================================================
  877. proc insertTemplateBody {name} {
  878.     global templateBodys
  879.     set pos [getPos]
  880.     set start [lineStart $pos]
  881.     set indent [eval "getText [join [search -s -r 1 -f 1 -n -- "\[ \\t\]*" $start]]"]
  882.     insertText [lindex [split "$templateBodys($name)" "%"] 0]
  883.     foreach bodyLine [lrange [split "$templateBodys($name)" "%"] 1 100] {
  884.         insertText \r${indent}${bodyLine}
  885.     }
  886.     goto $pos
  887. }
  888. #================================================================================
  889. proc cASE {} {
  890.     insertText "CASE"
  891.     templateCASE
  892. }
  893. proc templateCASE {} {
  894.     insertTemplateBody CASE
  895.     goto [expr [getPos]+1]
  896. }
  897.  
  898. #================================================================================
  899. proc fOR {} {
  900.     insertText "FOR"
  901.     templateFOR
  902. }
  903. proc templateFOR {} {
  904.     insertTemplateBody FOR
  905.     goto [expr [getPos]+1]
  906. }
  907.  
  908. #================================================================================
  909. proc wHILE {} {
  910.     insertText "WHILE"
  911.     templateWHILE
  912. }
  913. proc templateWHILE {} {
  914.     insertTemplateBody WHILE
  915.     goto [expr [getPos]+2]
  916. }
  917.  
  918. #================================================================================
  919. proc wITH {} {
  920.     insertText "WITH"
  921.     templateWITH
  922. }
  923. proc templateWITH {} {
  924.     insertTemplateBody WITH
  925.     goto [expr [getPos]+1]
  926. }
  927.  
  928. #================================================================================
  929. proc iF {} {
  930.     insertText "IF"
  931.     templateIF
  932. }
  933.  
  934. proc templateIF {} {
  935.     insertTemplateBody IF
  936.     goto [expr [getPos]+1]
  937. }
  938.  
  939. #================================================================================
  940. proc rEPEAT {} {
  941.     insertText "REPEAT"
  942.     templateREPEAT
  943. }
  944. proc templateREPEAT {} {
  945.     insertTemplateBody REPEAT
  946.     indentOnReturn
  947. }
  948.  
  949. #================================================================================
  950. proc fROM {} {
  951.     insertText "FROM"
  952.     templateFROM
  953. }
  954. proc templateFROM {} {
  955.     insertTemplateBody FROM
  956.     goto [expr [getPos]+1]
  957. }
  958.  
  959. #================================================================================
  960. proc pROCEDURE {} {
  961.     insertText "PROCEDURE"
  962.     templatePROCEDURE
  963. }
  964. proc templatePROCEDURE {} {
  965.     set winName [lindex [winNames -f] 0]
  966.     set procName [getline "PROCEDURE Name : "]
  967.     bringToFront $winName
  968.     if {[string length $procName] < 1} {
  969.         return;
  970.     }
  971.     set pos [expr "[getPos]+1+[string length $procName]"]
  972.     insertText " $procName;"
  973.     if {[string toupper [fileExt]] != "DEF"} {
  974.         carriageReturn
  975.         insertText "BEGIN (* $procName *)"
  976.         carriageReturn
  977.         insertText "END $procName;"
  978.         carriageReturn
  979.     }
  980.     goto $pos
  981. }
  982.  
  983. #================================================================================
  984.  
  985. # An aux proc
  986.  
  987. proc askForModuleName {prompt} {
  988.     set modName [getline "$prompt"]
  989.     if {([string length $modName] < 1)} {
  990.         return ""
  991.     }
  992.     if {[regexp {[^A-Za-z0-9]} $modName]} then {
  993.         alertnote "The module name “$modName“ contains illegal characters!"
  994.         return ""
  995.     }
  996.     if {([string length $modName] > 12)} {
  997.         set quest "“$modName“ is too long (> 12 chars). You should stop to change it. Ok?"
  998.         if {[askyesno $quest] == "yes"} {
  999.             return ""
  1000.         }
  1001.     }
  1002.     return $modName
  1003. }
  1004.  
  1005. proc openOrMakeFile {prompt ext} {
  1006.     if {$prompt == ""} then {
  1007.         set modName "$ext"
  1008.         set modFName "$modName"
  1009.     } else {
  1010.         set modName [askForModuleName $prompt]
  1011.         set modFName "$modName.$ext"
  1012.     }
  1013.     if {$modName == ""} then { return }
  1014.     set winList [winNames]
  1015.     if { [IsInList $winList $modFName] } then {
  1016.         # File already exists and is open
  1017.         bringToFront $modFName
  1018.     } else {
  1019.         # Create new file with the proper name
  1020.         new -n $modFName
  1021.     }
  1022.     set modName [file tail $modFName]
  1023.     set modName [file rootname $modName]
  1024.     return $modName
  1025. }
  1026.  
  1027. #================================================================================
  1028. proc mODULE {} {
  1029.     # Used by calling submenu M2/Templates/MODULE
  1030.     set modName [openOrMakeFile "Program MODULE Name : " "MOD"]
  1031.     if {$modName != ""} then {
  1032.         insertText "MODULE"
  1033.         modBODY $modName
  1034.     }
  1035. }
  1036.  
  1037. proc templateMODULE {} {
  1038.     # Used while expanding keyword MODULE
  1039.     set modName [askForModuleName "Program MODULE Name: "]
  1040.     if {$modName != ""} then {
  1041.         modBODY $modName
  1042.     }
  1043. }
  1044.  
  1045. #================================================================================
  1046. proc modBODY {modName} {
  1047.     global M2RightShift
  1048.     if {[string length $modName] < 1} {
  1049.         return;
  1050.     }
  1051.     insertText " $modName;"
  1052.     carriageReturn
  1053.     carriageReturn
  1054.     insertText $M2RightShift
  1055.     insertText "(*"
  1056.     carriageReturn
  1057.     insertText $M2RightShift
  1058.     insertText "Implementation and Revisions:"
  1059.     carriageReturn
  1060.     insertText "============================"
  1061.     carriageReturn
  1062.     carriageReturn
  1063.     insertText "Author  Date        Description"
  1064.     carriageReturn
  1065.     insertText "------  ----        -----------"
  1066.     carriageReturn
  1067.     insertText "[initials]      [format "%-11s" "[lindex [mtime [now] short] 0]"]"
  1068.     insertText "First implementation"
  1069.     carriageReturn
  1070.     unIndent
  1071.     insertText "*)"
  1072.     carriageReturn
  1073.     unIndent
  1074.     set pos [getPos]
  1075.     carriageReturn
  1076.     insertText "BEGIN (* $modName *)"
  1077.     carriageReturn
  1078.     insertText "END $modName."
  1079.     carriageReturn
  1080.     goto $pos
  1081.     indentOnReturn
  1082. }
  1083.  
  1084. #================================================================================
  1085. proc defBODY {modName} {
  1086.     global M2RightShift
  1087.     global M2Author
  1088.     if {[string length $modName] < 1} {
  1089.         return;
  1090.     }
  1091.     insertText " $modName;"
  1092.     carriageReturn
  1093.     carriageReturn
  1094.     insertText $M2RightShift
  1095.     insertText "(*******************************************************************"
  1096.     carriageReturn
  1097.     carriageReturn
  1098.     insertText $M2RightShift
  1099.     insertText "Module  $modName     (Version 1.0)"
  1100.     carriageReturn
  1101.     carriageReturn
  1102.     insertText $M2RightShift
  1103.     insertText "Copyright (c) 1992 by $M2Author and Swiss"
  1104.     carriageReturn
  1105.     insertText "Federal Institute of Technology Zurich ETHZ"
  1106.     carriageReturn
  1107.     carriageReturn
  1108.     unIndent
  1109.     insertText "Version written for:"
  1110.     carriageReturn
  1111.     insertText $M2RightShift
  1112.     insertText "MacMETH_V3.2    (1-Pass Modula-2 implementation)"
  1113.     carriageReturn
  1114.     carriageReturn
  1115.     unIndent
  1116.     insertText "Purpose (*.  purpose  .*)"
  1117.     carriageReturn
  1118.     carriageReturn
  1119.     insertText "Remarks (*.  remarks  .*)"
  1120.     carriageReturn
  1121.     carriageReturn
  1122.     carriageReturn
  1123.     insertText "Programming"
  1124.     carriageReturn
  1125.     carriageReturn
  1126.     insertText $M2RightShift
  1127.     insertText "o Design"
  1128.     carriageReturn
  1129.     insertText $M2RightShift
  1130.     insertText "$M2Author         [lindex [mtime [now] short] 0]"
  1131.     carriageReturn
  1132.     carriageReturn
  1133.     unIndent
  1134.     insertText "o Implementation"
  1135.     carriageReturn
  1136.     insertText $M2RightShift
  1137.     insertText "$M2Author         [lindex [mtime [now] short] 0]"
  1138.     carriageReturn
  1139.     carriageReturn
  1140.     carriageReturn
  1141.     unIndent
  1142.     insertText "Swiss Federal Institute of Technology Zurich ETHZ"
  1143.     carriageReturn
  1144.     insertText "CH-8092 Zurich"
  1145.     carriageReturn
  1146.     insertText "Switzerland"
  1147.     carriageReturn
  1148.     carriageReturn
  1149.     insertText "Last revision of definition:  [lindex [mtime [now] short] 0]  [initials]"
  1150.     carriageReturn
  1151.     carriageReturn
  1152.     unIndent
  1153.     unIndent
  1154.     insertText "*******************************************************************)"
  1155.     carriageReturn
  1156.     carriageReturn
  1157.     set pos [getPos]
  1158.     unIndent
  1159.     carriageReturn
  1160.     insertText "END $modName."
  1161.     carriageReturn
  1162.     goto $pos
  1163.     indentOnReturn
  1164. }
  1165.  
  1166. #================================================================================
  1167. proc defToMod {} {
  1168.     set winName [lindex [winNames -f] 0]
  1169.     if {$winName == ""} return
  1170.     set modName [getText 0 [nextLineStart 0]]
  1171.     if {[lindex $modName 0] != "DEFINITION"} {
  1172.         beep
  1173.         alertnote "wrong window"
  1174.         return
  1175.     }
  1176.     if {[lindex $modName 1] != "MODULE"} {
  1177.         beep
  1178.         alertnote "wrong window"
  1179.         return
  1180.     }
  1181.     set modName [lindex $modName 2]
  1182.     set modName [string range $modName 0 [expr [string length $modName] - 2]]
  1183.     if {$modName == ""} {
  1184.         beep
  1185.         alertnote "wrong window"
  1186.         return
  1187.     }
  1188.     set modName [openOrMakeFile "" "$modName.MOD"]
  1189.     insertText "IMPLEMENTATION MODULE "
  1190.     modBODY $modName
  1191.     set newName [lindex [winNames -f] 0]
  1192.     unIndent
  1193.     bringToFront $winName
  1194.     set pos [search -s -r 1 -f 1 -i 0 -n -- "FROM|IMPORT" 0]
  1195.     set end [search -s -r 1 -f 1 -i 0 -n -- "TYPE|PROCEDURE|VAR|CONST|END" 0]
  1196.     if {$pos != ""} {
  1197.         set text [getText [lineStart $pos] [lineStart $end]]
  1198.         insertText -w $newName $text
  1199.     }
  1200.     set end 0
  1201.     set matchStr "PROCEDURE\[ \\t\]*\[A-Za-z0-9\]+\[ \\t\]*(\\(\[^\\)\]*\\))?\[^\\;\]*\;"
  1202.     set pos [search -s -r 1 -f 1  -i 0 -n -- $matchStr $end]
  1203.     set end [lindex $pos 1]
  1204.     while {$pos != "" } {
  1205.         set text [getText [lineStart $pos] [nextLineStart [lindex $pos 1]]]
  1206.         insertText -w $newName $text
  1207.         set insertion [format "%[string first [lindex $text 0] $text]s" ""]
  1208.         set procName [lindex [split "[lindex $text 1]" "(;"] 0]
  1209.         insertText -w $newName $insertion
  1210.         insertText -w $newName "BEGIN (* $procName *)"
  1211.         insertText -w $newName "\r"
  1212.         insertText -w $newName $insertion
  1213.         insertText -w $newName "END $procName;"
  1214.         insertText -w $newName "\r\r"    
  1215.         set pos [search -s -r 1 -f 1  -i 0 -n -- $matchStr $end]
  1216.         set end [lindex $pos 1]
  1217.     }
  1218.     bringToFront $newName
  1219.     changeMode "M2"
  1220. }
  1221.  
  1222.  
  1223. #================================================================================
  1224. proc dEFINITION {} {
  1225.     # Used by calling submenu M2/Templates/DEFINITION
  1226.     set modName [openOrMakeFile "DEFINITION MODULE Name: " "DEF"]
  1227.     if {$modName != ""} then {
  1228.         insertText "DEFINITION MODULE"
  1229.         defBODY $modName
  1230.         prevPlaceholder
  1231.         prevPlaceholder
  1232.     }
  1233. }
  1234.  
  1235. proc templateDEFINITION {} {
  1236.     # Used while expanding keyword DEFINITION
  1237.     insertText " MODULE"
  1238.     set modName [askForModuleName "DEFINITION MODULE Name: "]
  1239.     if {$modName != ""} then {
  1240.         defBODY $modName
  1241.         prevPlaceholder
  1242.         prevPlaceholder
  1243.     }
  1244. }
  1245.  
  1246. #================================================================================
  1247.  
  1248. proc iMPLEMENTATION {} {
  1249.     # Used by calling submenu M2/Templates/IMPLEMENTATION
  1250.     set modName [openOrMakeFile "IMPLEMENTATION MODULE Name : " "MOD"]
  1251.     if {$modName != ""} then {
  1252.         insertText "IMPLEMENTATION MODULE"
  1253.         modBODY $modName
  1254.     }
  1255. }
  1256.  
  1257. proc templateIMPLEMENTATION {} {
  1258.     # Used while expanding keyword IMPLEMENTATION
  1259.     set modName [askForModuleName "IMPLEMENTATION MODULE Name: "]
  1260.     if {$modName != ""} then {
  1261.         insertText " MODULE"
  1262.         modBODY $modName
  1263.     }
  1264. }
  1265.  
  1266. #================================================================================
  1267. proc indentOnReturn {} {
  1268.     global M2RightShift
  1269.     actionOnReturn
  1270.     insertText $M2RightShift
  1271. }
  1272.  
  1273. #================================================================================
  1274. proc modulaReturn {} {
  1275.      global returnWords
  1276.      global returnCompleteWords
  1277.     set line [getCurLine]
  1278.     set first [firstWord $line]
  1279.     set first [trim $first]
  1280.      if {[lsearch " $returnWords " $first] > -1} {
  1281.          if {[lsearch " $returnCompleteWords " $first] > -1} {
  1282.              set pos [getPos]
  1283.              set start [lineStart $pos]
  1284.              set leftText [getText $start $pos]
  1285.              if {$first == "FOR"} {
  1286.                  if {[string first "TO" $leftText] > -1} {
  1287.                      indentOnReturn
  1288.                      return
  1289.                  }
  1290.                  if {[string first ":=" $leftText] > -1} {
  1291.                      goto [expr "$start + [string first "TO" $line] + 3"]
  1292.                      return
  1293.                  }
  1294.                  if {[string first "FOR" $leftText] > -1} {
  1295.                      goto [expr "$start + [string first ":=" $line] + 3"]
  1296.                      return
  1297.                  }
  1298.                  goto [expr "$start + [string first "FOR" $line] + 4"]
  1299.              }
  1300.              if {$first == "FROM"} {
  1301.                  if {[string first "IMPORT" $leftText] > -1} {
  1302.                      actionOnReturn
  1303.                      return
  1304.                  }
  1305.                  if {[string first "FROM" $leftText] > -1} {
  1306.                      goto [expr "$start + [string first "IMPORT" $line] + 7"]
  1307.                      return
  1308.                  }
  1309.                  goto [expr "$start + [string first "FROM" $line] + 5"]
  1310.              }
  1311.          } else {
  1312.             indentOnReturn
  1313.          }
  1314.     } else {
  1315.         actionOnReturn
  1316.     }
  1317. }
  1318.  
  1319. #================================================================================
  1320. proc modulaSpace {} {
  1321.      global spaceWords
  1322.     set line [getCurLine]
  1323.     set first [firstWord $line]
  1324.     set first [trim $first]
  1325.     set rest [restWord $line]
  1326.     set rest [trim $rest]
  1327.      if {[lsearch " $spaceWords " $first] > -1} {
  1328.          if {[string length $rest] > 0} {
  1329.              deleteText [getPos] [selEnd]
  1330.              insertText " "
  1331.          } else {
  1332.             if {[catch template$first]} {
  1333.                 beep
  1334.                 alertnote "Template for:$first not defined"
  1335.             }             
  1336.          }
  1337.     } else {
  1338.         deleteText [getPos] [selEnd]
  1339.         insertText " "
  1340.     }
  1341. }
  1342.  
  1343. #================================================================================
  1344. proc expandSpace {} {
  1345.     global expandWords
  1346.     set pos [getPos]
  1347.     backwardWord
  1348.     set bPos [getPos]
  1349.     if {$bPos == 1} {
  1350.         set text " "
  1351.         regexp "\[A-Za-z\]" [getText 0 1] text
  1352.         if {$text != " "} {
  1353.             set bPos 0
  1354.         }
  1355.     }
  1356.  
  1357.     forwardWord
  1358.     set fPos [getPos]
  1359.     goto $pos
  1360.     set origWord [getText $bPos $fPos]
  1361.     set word [string toupper $origWord]
  1362.     set ind [lsearch $expandWords $origWord*]
  1363.     if {$ind == -1} {
  1364.         wordCompletion
  1365.         return
  1366.     }
  1367.     set expandWord [lindex $expandWords $ind]
  1368.     if {$expandWord != $origWord} {
  1369.         replaceText $bPos $fPos $expandWord
  1370.     } 
  1371. }
  1372.  
  1373. #================================================================================
  1374. proc M2MarkFile {} {
  1375.     set pos 0
  1376.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 {^[ \t]*PROCEDURE} $pos} res]} {
  1377.         set start [expr [lindex $res 1] + 1]
  1378.         set end [nextLineStart $start]
  1379.         regexp "\[A-za-z\]*" [getText $start $end] text
  1380.         set pos $end
  1381.         set inds($text) [lineStart [expr $start - 1]]
  1382.     }
  1383.     if {[info exists inds]} {
  1384.         foreach f [lsort [array names inds]] {
  1385.             set next [nextLineStart $inds($f)]
  1386.             setNamedMark $f $inds($f) $next $next
  1387.         }
  1388.     }
  1389. }
  1390.  
  1391. #================================================================================
  1392. # Colorize Modula code.
  1393. #================================================================================
  1394.  
  1395. regModeKeywords -b {(*} {*)} -c red -k blue M2 $expandWords
  1396.  
  1397. proc colorizeM2Comments {} {
  1398. }
  1399.